home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / boot / autoload.pl < prev    next >
Encoding:
Text File  |  1997-10-28  |  5.9 KB  |  233 lines
  1. /*  $Id: autoload.pl,v 1.7 1997/10/28 13:40:26 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Automatic library loading
  7. */
  8.  
  9. :- module($autoload,
  10.     [ $find_library/5
  11.     , $in_library/2
  12.     , $define_predicate/1
  13.     , $update_library_index/0
  14.     , make_library_index/1
  15.     , make_library_index/2
  16.     , autoload/0
  17.     , autoload/1
  18.     ]).
  19.  
  20. :- dynamic
  21.     library_index/3.            % Head x Module x Path
  22. :- volatile
  23.     library_index/3.
  24.  
  25. %    $find_library(+Module, +Name, +Arity, -LoadModule, -Library)
  26. %
  27. %    Locate a predicate in the library.  Name and arity are the name
  28. %    and arity of the predicate searched for.  `Module' is the
  29. %    preferred target module.  The return values are the full path names
  30. %    of the library and module declared in that file.
  31.  
  32. $find_library(Module, Name, Arity, LoadModule, Library) :-
  33.     load_library_index,
  34.     functor(Head, Name, Arity),
  35.     (   library_index(Head, Module, Library),
  36.         LoadModule = Module
  37.     ;   library_index(Head, LoadModule, Library)
  38.     ), !.
  39.  
  40. %    $in_library(?Name, ?Arity)
  41. %    Is true if Name/Arity is in the autoload libraries.
  42.  
  43. $in_library(Name, Arity) :-
  44.     load_library_index,
  45.     library_index(Head, _, _),
  46.     functor(Head, Name, Arity).
  47.  
  48. %    $define_predicate(+Head)
  49. %    Make sure pred can be called.  First test if the predicate is
  50. %    defined.  If not, invoke the autoloader.
  51.  
  52. :- module_transparent
  53.     $define_predicate/1.
  54.  
  55. $define_predicate(Head) :-
  56.     $defined_predicate(Head), !.
  57. $define_predicate(Term) :-
  58.     $strip_module(Term, Module, Head),
  59.     functor(Head, Name, Arity),
  60.     flag($enable_autoload, on, on),
  61.     $find_library(Module, Name, Arity, LoadModule, Library),
  62.     flag($autoloading, Old, Old+1),
  63.     (   Module == LoadModule
  64.     ->  ignore(ensure_loaded(Library))
  65.     ;   ignore(Module:use_module(Library, [Name/Arity]))
  66.     ),
  67.     flag($autoloading, _, Old),
  68.     $define_predicate(Term).
  69.  
  70.  
  71.         /********************************
  72.         *          UPDATE INDEX        *
  73.         ********************************/
  74.  
  75. $update_library_index :-
  76.     $check_file(library('INDEX.pl'), IndexFile),
  77.     file_directory_name(IndexFile, Dir),
  78.     update_library_index(Dir),
  79.     fail.
  80. $update_library_index.
  81.  
  82. update_library_index(Dir) :-
  83.     concat_atom([Dir, '/INDEX.pl'], IndexFile),
  84.     access_file(IndexFile, write),
  85.     make_library_index(Dir).
  86.  
  87. clear_library_index :-
  88.     retractall(library_index(_, _, _)).
  89.  
  90.         /********************************
  91.         *           LOAD INDEX        *
  92.         ********************************/
  93.  
  94. load_library_index :-
  95.     library_index(_, _, _), !.        % loaded
  96. load_library_index :-
  97.     $check_file(library('INDEX'), Index),
  98.         file_directory_name(Index, Dir),
  99.         read_index(Index, Dir),
  100.     fail.
  101. load_library_index.
  102.     
  103. read_index(Index, Dir) :-
  104.     seeing(Old), see(Index),
  105.     repeat,
  106.         read(Term),
  107.         (   Term == end_of_file
  108.         ->  !
  109.         ;   assert_index(Term, Dir),
  110.             fail
  111.         ),
  112.     seen, see(Old).
  113.  
  114. assert_index(index(Name, Arity, Module, File), Dir) :- !,
  115.     functor(Head, Name, Arity),
  116.     concat_atom([Dir, '/', File], Path),
  117.     assertz(library_index(Head, Module, Path)).
  118. assert_index(Term, Dir) :-
  119.     $warning('Illegal term in INDEX.pl of directory ~w: ~w', [Dir, Term]).
  120.     
  121.  
  122.         /********************************
  123.         *       CREATE INDEX.pl        *
  124.         ********************************/
  125.  
  126. make_library_index(Dir) :-
  127.     make_library_index(Dir, ['*.pl']).
  128.     
  129. make_library_index(Dir, Patterns) :-
  130.     Index = 'INDEX.pl',
  131.     concat_atom([Dir, '/', Index], AbsIndex),
  132.     access_file(AbsIndex, write), !,
  133.     absolute_file_name('', OldDir),
  134.     chdir(Dir),
  135.     expand_index_file_patterns(Patterns, Files),
  136.     (   library_index_out_of_date(Index, Files)
  137.     ->  format('Making library index for ~w ... ', Dir), flush,
  138.         do_make_library_index(Index, Files),
  139.         format('ok~n')
  140.     ;   true
  141.     ),
  142.     chdir(OldDir).
  143. make_library_index(Dir, _) :-
  144.     $warning('make_library_index/1: Cannot write ~w', [Dir]).
  145.  
  146.  
  147. expand_index_file_patterns(Patterns, Files) :-
  148.     maplist(expand_file_name, Patterns, NestedFiles),
  149.     flatten(NestedFiles, F0),
  150.     subtract(F0, ['INDEX.pl', 'index.pl', 'Make.pl', 'make.pl'], Files).
  151.  
  152.  
  153. library_index_out_of_date(Index, _Files) :-
  154.     \+ exists_file(Index), !.
  155. library_index_out_of_date(Index, Files) :-
  156.     time_file(Index, IndexTime),
  157.     (   time_file('.', DotTime),
  158.         DotTime @> IndexTime
  159.     ;   member(File, Files),
  160.         time_file(File, FileTime),
  161.         FileTime @> IndexTime
  162.     ), !.
  163.  
  164.  
  165. do_make_library_index(Index, Files) :-
  166.     open(Index, write, Fd),
  167.     index_header(Fd),
  168.     checklist(index_file(Fd), Files),
  169.     close(Fd).
  170.  
  171. index_file(Fd, File) :-
  172.     open(File, read, In),
  173.     read(In, Term),
  174.     close(In),
  175.     Term = (:- module(Module, Public)), !,
  176.     delete_suffix(File, '.pl', Base),
  177.     forall( member(Name/Arity, Public),
  178.         format(Fd, 'index((~k), ~k, ~k, ~k).~n',
  179.                [Name, Arity, Module, Base])).
  180. index_file(_, _).
  181.  
  182. delete_suffix(File, Suffix, Base) :-
  183.     concat(Base, Suffix, File), !.
  184. delete_suffix(File, _, File).
  185.  
  186. index_header(Fd):-
  187.     format(Fd, '/*  $Id: autoload.pl,v 1.7 1997/10/28 13:40:26 jan Exp $~n~n', []),
  188.     format(Fd, '    Creator: make/0~n~n', []),
  189.     format(Fd, '    Purpose: Provide index for autoload~n', []),
  190.     format(Fd, '*/~n~n', []).
  191.  
  192.          /*******************************
  193.          *       DO AUTOLOAD        *
  194.          *******************************/
  195.  
  196. %    autoload([options ...])
  197. %
  198. %    Force all necessary autoloading to be done now.
  199.  
  200. autoload :-
  201.     autoload([]).
  202.  
  203. autoload(Options) :-
  204.     option(Options, verbose/on, Verbose),
  205.     $style_check(Old, Old), 
  206.     style_check(+dollar), 
  207.     please(autoload, OldAutoLoad, off),
  208.     findall(Pred, needs_autoloading(Pred), Preds),
  209.     please(autoload, _, OldAutoLoad),
  210.     $style_check(_, Old),
  211.     (   Preds == []
  212.     ->  true
  213.     ;   please(verbose_autoload, OldVerbose, Verbose),
  214.         please(autoload, OldAutoLoad2, on),
  215.         checklist($define_predicate, Preds),
  216.         please(autoload, _, OldAutoLoad2),
  217.         please(verbose_autoload, _, OldVerbose),
  218.         autoload(Verbose)
  219.     ).
  220.     
  221. needs_autoloading(Module:Head) :-
  222.     predicate_property(Module:Head, undefined), 
  223.     \+ predicate_property(Module:Head, imported_from(_)), 
  224.     functor(Head, Functor, Arity), 
  225.     $in_library(Functor, Arity).
  226.  
  227. option(Options, Name/Default, Value) :-
  228.     (   memberchk(Name = Value, Options)
  229.     ->  true
  230.     ;   Value = Default
  231.     ).
  232.  
  233.